home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / a_to_d / dwsock11 / time.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  6KB  |  245 lines
  1. {--------------------------------------------------------------}
  2. {    The main form unit for NETTIME app                           }
  3. {                                                              }
  4. {    By Ulf S÷derberg, ulfs@sysinno.se                            }
  5. {                                                              }
  6. {    History                                                      }
  7. {        V1.0        950404        US                                       }
  8. {--------------------------------------------------------------}
  9.  
  10. unit Time;
  11.  
  12. interface
  13.  
  14. uses
  15.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  16.     Forms, Dialogs, StdCtrls, ExtCtrls, DWinSock, Spin;
  17.  
  18. type
  19.     TfrmTime = class(TForm)
  20.         sockTime: TClientSocket;
  21.     btnTime: TButton;
  22.         Timer1: TTimer;
  23.     comboHost: TComboBox;
  24.     hdrInfo: THeader;
  25.     gbTime: TGroupBox;
  26.     gbOptions: TGroupBox;
  27.     Label1: TLabel;
  28.     chkDST: TCheckBox;
  29.     spinGMT: TSpinButton;
  30.     Label2: TLabel;
  31.     lblGMT: TLabel;
  32.     clock: TPaintBox;
  33.     Panel1: TPanel;
  34.         procedure btnTimeClick(Sender: TObject);
  35.         procedure sockTimeDisconnect(Sender: TObject);
  36.         procedure sockTimeRead(Sender: TObject);
  37.         procedure sockTimeConnect(Sender: TObject);
  38.         procedure Timer1Timer(Sender: TObject);
  39.         procedure FormCreate(Sender: TObject);
  40.     procedure sockTimeInfo(Sender: TObject; icode: TSockInfo);
  41.     procedure spinGMTDownClick(Sender: TObject);
  42.     procedure spinGMTUpClick(Sender: TObject);
  43.     procedure clockPaint(Sender: TObject);
  44.   private
  45.     { Private declarations }
  46.   public
  47.         { Public declarations }
  48.         elapsedtime    : integer;
  49.         hh, mm, ss    : integer;
  50.     cnt                    : integer;
  51.     thetime            : longint;
  52.  
  53.     procedure GetTime;
  54.   end;
  55.  
  56. var
  57.     frmTime: TfrmTime;
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. procedure TfrmTime.btnTimeClick(Sender: TObject);
  64. begin
  65.     Cursor := crHourGlass;
  66.     elapsedtime := 0;
  67.   cnt := 0;
  68.   Timer1.Enabled := true;
  69.     sockTime.Host := comboHost.Text;
  70.     sockTime.Open;
  71.   btnTime.Enabled := false;
  72. end;
  73.  
  74. procedure TfrmTime.sockTimeDisconnect(Sender: TObject);
  75. begin
  76.     btnTime.Enabled := true;
  77.   hdrInfo.Sections[1] := 'Disconnected';
  78. end;
  79.  
  80. procedure TfrmTime.sockTimeRead(Sender: TObject);
  81. var
  82.   p        : PChar;
  83. begin
  84.     hdrInfo.Sections[1] := 'Reading time';
  85.   p := @thetime;
  86.   p := p + cnt;
  87.     cnt := cnt + sockTime.RecvBuf(p^, 4 - cnt);
  88.   if cnt = 4 then
  89.         GetTime;
  90. end;
  91.  
  92. procedure TfrmTime.GetTime;
  93. var
  94.     n        : integer;
  95.     l        : longint;
  96.     tl    : longint;
  97.     tf    : double;
  98.     dt    : TDateTime;
  99.   gmt, c    : integer;
  100. begin
  101.     l := thetime;
  102.     tl := ntohl(l);
  103.     tf := tl and MaxLongInt;
  104.     if tl < 0 then
  105.         begin
  106.             tf := tf + MaxLongInt;
  107.             tf := tf + 1;
  108.         end;
  109.     tl := round(tf - 2208988800.0);
  110.     ss := tl mod 60;
  111.     tl := tl div 60;
  112.     mm := tl mod 60;
  113.     tl := tl div 60;
  114.     if chkDST.Checked then
  115.         tl := tl + 1;
  116.   Val(lblGMT.Caption, gmt, c);
  117.   tl := tl + gmt;
  118.     hh := tl mod 24;
  119.     tl := tl div 24;
  120.     dt := EncodeTime(hh, mm, ss, 0);
  121.     gbTime.Caption := 'Time: ' + TimeToStr(dt);
  122.   sockTime.Close;
  123.     btnTime.Enabled := true;
  124.   hdrInfo.Sections[1] := 'Disconnected';
  125. end;
  126.  
  127. procedure TfrmTime.sockTimeConnect(Sender: TObject);
  128. begin
  129.     Cursor := crDefault;
  130.   Timer1.Enabled := false;
  131.   cnt := 0;
  132.   hdrInfo.Sections[1] := 'Connected to ' + sockTime.Address;
  133. end;
  134.  
  135. procedure TfrmTime.Timer1Timer(Sender: TObject);
  136. begin
  137.     inc(elapsedtime);
  138.     if elapsedtime > 20 then
  139.         begin
  140.             Timer1.Enabled := false;
  141.             sockTime.Close;
  142.       MessageDlg('Connect time out', mtInformation, [mbOk], 0); 
  143.             btnTime.Enabled := true;
  144.         end;
  145. end;
  146.  
  147. procedure TfrmTime.FormCreate(Sender: TObject);
  148. begin
  149.     Timer1.Enabled := false;
  150.   elapsedtime := 0;
  151. end;
  152.  
  153. procedure TfrmTime.sockTimeInfo(Sender: TObject; icode: TSockInfo);
  154. begin
  155.     case icode of
  156.       siLookup : hdrInfo.Sections[1] := 'Looking up host ' + sockTime.Host;
  157.       siConnect :    hdrInfo.Sections[1] := 'Connecting ' + sockTime.Address;
  158.   end;
  159. end;
  160.  
  161. procedure TfrmTime.spinGMTDownClick(Sender: TObject);
  162. var
  163.     n, c    : integer;
  164. begin
  165.     Val(lblGMT.Caption, n, c);
  166.   dec(n);
  167.     lblGMT.Caption := IntToStr(n);
  168. end;
  169.  
  170. procedure TfrmTime.spinGMTUpClick(Sender: TObject);
  171. var
  172.     n, c    : integer;
  173. begin
  174.     Val(lblGMT.Caption, n, c);
  175.   inc(n);
  176.     lblGMT.Caption := IntToStr(n);
  177. end;
  178.  
  179. procedure TfrmTime.clockPaint(Sender: TObject);
  180. var
  181.     cx, cy        : real;
  182.   x,    y            : integer;
  183.   r                    : real;
  184.   a                    : integer;
  185.  
  186.   procedure Polar(radius : real);
  187.   var
  188.       v    : integer;
  189.   begin
  190.       v := a - 15;
  191.       x := round(cx + radius * cos(6 * v * pi / 180));
  192.     y := round(cx + radius * sin(6 * v * pi / 180));
  193.   end;
  194.  
  195. begin
  196.      with TPaintBox(Sender) do
  197.       begin
  198.         cx := Width / 2;
  199.       cy := Height / 2;
  200.       r := cx;
  201.       for a := 0 to 59 do
  202.           begin
  203.                     Polar(r);
  204.           Canvas.MoveTo(x, y);
  205.           if (a mod 5) = 0 then
  206.               begin
  207.                 Canvas.Pen.Color := clBlack;
  208.                   Polar(r - 5);
  209.             end
  210.           else
  211.               begin
  212.                 Canvas.Pen.Color := clBlue;
  213.                   Polar(r - 3);
  214.             end;
  215.           Canvas.LineTo(x, y);
  216.         end;
  217.  
  218.       { Hours }
  219.           Canvas.Pen.Color := clRed;
  220.           a := ((hh * 60) + mm) div 12;
  221.           r := cx * 60 / 100;
  222.           Polar(r);
  223.             Canvas.MoveTo(round(cx), round(cy));
  224.             Canvas.LineTo(x, y);
  225.  
  226.       { Minutes }
  227.           a := mm;
  228.           r := cx * 85 / 100;
  229.           Polar(r);
  230.             Canvas.MoveTo(round(cx), round(cy));
  231.             Canvas.LineTo(x, y);
  232.  
  233.       { Seconds }
  234.           Canvas.Pen.Color := clWhite;
  235.           a := ss;
  236.           r := cx * 90 / 100;
  237.           Polar(r);
  238.             Canvas.MoveTo(round(cx), round(cy));
  239.             Canvas.LineTo(x, y);
  240.  
  241.       end;
  242. end;
  243.  
  244. end.
  245.